Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/PASCAL/0188.ZIP/ITRMPORT.INC

Text File | 1985-02-20 | 11KB | 294 lines

Const
     RECV_BUF_SIZE = 2048;             {this may be changed to
                                        whatever size you need}
{ *** Port addresses *** }
     THR = $3F8;                       {Transmitter Holding Register: the
                                        serial port address we use to send
                                        data}
     IER = $3F9;                       {Interrupt Enable Register for the
                                        serial port}
     LCR = $3FB;                       {Line Control Register for the serial
                                        port. Determines data bits, stop bits
                                        and parity, contributes to setting
                                        baud-rate}
     MCR = $3FC;                       {Modem Control Register}
     LSR = $3FD;                       {Line Status Register}
     MSR = $3FE;                       {Modem Status Register}
     IMR = $021;                       {Interrupt Mask Register port address
                                        of Intel 8259A Programmable Interrupt
                                        controller}
{ *** Masks *** }
     ENABLE_OUT2 = 8;                  {Setting bit 3 of MCR enables OUT2}
     ENABLE_DAV = 1;                   {Setting bit 0 of IER enables Data
                                        AVailable interrupt from serial port}
     ENABLE_IRQ4 = $EF;                {Clearing bit 5 of IMR enables serial
                                        interrupts to reach the CPU}
     DISABLE_OUT2 = 1;                 {Clearing MCR disables OUT2}
     DISABLE_DAV = 0;                  {Clearing IER disables Data
                                       AVailable interrupt from serial port}
     DISABLE_IRQ4 = $10;               {Setting bit 5 of IMR stops serial
                                        interrupts from reaching the CPU}
     SET_BAUD = $80;                   {Setting bit 7 of LCR allows us to set
                                        the baud rate of the serial port}
     SET_PARMS = $7F;                  {Clearing bit 7 of LCR allows us to set
                                        non-baud-rate parameters on the
                                        serial port}
Type
    parity_set        = (none,even);    {readability and expansion}
Var
   buf_start, buf_end    : integer;    {NOTE: these will change by them-
                                        selves in the background}
   recv_buffer           : array [1..RECV_BUF_SIZE] of byte;
                                       {also self-changing}
   speed                 : integer;    {I don't know the top speed these
                                        routines will handle}
   dbits                 : 7..8;       {only ones most people use}
   stop_bits             : 1..2;       {does anyone use 2?}
   parity                : parity_set;  {even and none are the common ones}

function cgetc(TimeLimit : integer) : integer;
{if a byte is recieved at COM1: in less than TimeLimit seconds,
 returns byte as an integer, else returns -1}
const
     TIMED_OUT = -1;
begin
     TimeLimit := TimeLimit shl 10;     {convert TimeLimit to millisecs}
     while (buf_start = buf_end) and (TimeLimit > 0) do
     begin
          delay(1);
          TimeLimit := pred(TimeLimit)
     end;
     if (TimeLimit >= 0) and (buf_start <> buf_end) then
     begin
          inline ($FA);            {suspend interrupts}
          cgetc := recv_buffer[buf_start];
          buf_start := succ(buf_start);
          if buf_start > RECV_BUF_SIZE then
          buf_start := 1;
          inline ($FB);            {resume interrupts}
     end
     else
         cgetc := TIMED_OUT;
end;

procedure send(c : byte);
var
   a : byte;
begin
  repeat
       a := port[LSR]
  until odd(a shr 5);
  port[THR] := c;
end;

procedure StrSend(s : bigstring);
var
   i : integer;
begin
     for i := 1 to length(s) do
         send(ord(s[i]));
end;

procedure SendPaced(s : bigstring);
label
     99;
const
     CRSYM = '<';
var
   i : integer;
   c : integer;
begin
     for i := 1 to Length(s) do
     begin
          if s[i] = CRSYM then
             send(13)
          else
             send(ord(s[i]));
          c := cgetc(1);
          if c <> -1 then
             write(chr(c))
          else begin
             sound(440);
             delay(20);
             nosound;
             goto 99
          end
     end;
99:
end;

{Communications routines for TURBO Pascal written by Alan Bishop,
 modified slightly by Scott Murphy.
 Handles standart COM1: ports with interrupt handling.  Includes
 support for only one port, and with no overflow, parity, or other
 such checking.  However, even some of the best communication programs
 don't do this anyway, and I never use it.  If you make modifications,
 please send me a copy if you have a simple way of doing it (CIS EMAIL,
 Usenet, MCI Mail, etc)  Hope these are useful.

Alan Bishop - CIS      - 72405,647
              Usenet   - bishop@ecsvax
              MCI Mail - ABISHOP
}
procedure update_uart;
{uses dbits, stop_bits, and parity}
var
   newparm, oldLCR : byte;
begin
 newparm := dbits-5;
 if stop_bits = 2 then newparm := newparm + 4;
 if parity = even then newparm := newparm + 24;
 oldLCR := port[LCR];
 port[LCR] := oldLCR and SET_PARMS;
 port[LCR] := newparm;
end;


procedure term_ready(state : boolean);
{if state = TRUE then set RTS true else set false}
var
   OldMCR : byte;
begin
     OldMCR := port[MCR];
     if state then
        port[MCR] := OldMCR or 1
     else
         port[MCR] := OldMCR and $FE
end;

function carrier : boolean;
{true if carrier, false if not}
begin
 carrier := odd(port[MSR] shr 7);
end;

procedure set_up_recv_buffer;
begin
 buf_start := 1;
 buf_end   := 1;
end;

procedure new_baud(rate : integer);
{has no problems with non-standard bauds}
var
   OldLCR : byte;
begin
 if rate <= 9600 then
 begin
  speed := rate;
  rate := trunc(115200.0/rate);
  OldLCR := port[LCR] or SET_BAUD;
  port[LCR] := OldLCR;
  port[THR] := lo(rate);
  port[IER] := hi(rate);
  port[LCR] := OldLCR and SET_PARMS;
 end;
end;

procedure init_port;
{installs interrupt sevice routine for serial port}
var a,b : integer;
    buf_len : integer;
begin
 update_uart;
 new_baud(speed);
 buf_len := RECV_BUF_SIZE;

 {this is the background routine}

 inline (
              $1E/                     {push ds}
              $0E/                     {push cs}
              $1F/                     {pop  ds                  ;ds := cs}
              $BA/*+23/                {mov  dx, offset ISR}
              $B8/$0C/$25/             {mov  ax, 250CH           ;set COM1: vector}
              $CD/$21/                 {int  21H}
              $8B/$BE/BUF_LEN/         {mov  di, buf_len}
              $89/$3E/*+87/            {mov  lcl_buf_len,di}
              $1F/                     {pop  ds}
              $2E/$8C/$1E/*+83/        {mov  lcl_ds, ds}
              $EB/$51/                 {jmp  exit}
{ISR:}        $FB/                     {sti}
              $1E/                     {push ds}
              $50/                     {push ax}
              $53/                     {push bx}
              $52/                     {push dx}
              $56/                     {push si}
              $2E/$8E/$1E/*+70/        {mov  ds,[lcl_ds]}
              $BA/$F8/$03/             {mov  dx, 3F8H           ;address RBR}
              $EC/                     {in   al, dx             ;read rbr}
              $BE/RECV_BUFFER/         {mov  si, recv_buffer    ;address start of recv_buffer}
              $8B/$1E/BUF_END/         {mov  bx, [buf_end]      ;index of current char in recv_buffer}
              $88/$40/$FF/             {mov  [bx+si-1],al       ;copy char to recv_buffer}
              $43/                     {inc  bx                 ;update buf_end}
              $E8/$22/$00/             {call adj_idx}
              $89/$1E/BUF_END/         {mov  [buf_end],bx}
              $3B/$1E/BUF_START/       {cmp  bx, [buf_start]}
              $75/$0C/                 {jnz  ISR_DONE}
              $8B/$1E/BUF_START/       {mov  bx,buf_start}
              $43/                     {inc  bx}
              $E8/$10/$00/             {call adj_idx}
              $89/$1E/BUF_START/       {mov  [buf_start],bx}
              $BA/$20/$00/             {mov  dx,20H            ;EOI command for 8259A PIC}
              $B0/$20/                 {mov  al,20H            ;EOI port for 8259A PIC}
              $EE/                     {out  dx,al             ;End Of Interrupt}
              $5E/                     {pop  si}
              $5A/                     {pop  dx}
              $5B/                     {pop  bx}
              $58/                     {pop  ax}
              $1F/                     {pop  ds}
              $CF/                     {iret}
{adj_idx:}    $2E/$8B/$16/*+11/        {mov  dx,[lcl_buf_len]}
              $42/                     {inc  dx}
              $39/$DA/                 {cmp  dx,bx}
              $75/$03/                 {jnz  no_change}
              $BB/$01/$00/             {mov  bx,1}
{no_change:}  $C3/                     {ret}
{lcl_buf_len;}$00/$00/                 {dw  0}
              $00/$01/                 {dw  1}
{exit:}       $90                      {nop}
 );
 port[IER] := ENABLE_DAV;              {interrupt enable}
 a := port[MCR];
 port[MCR] := a or ENABLE_OUT2;        {preserve RTS and enable OUT2}
 a := port[IMR];
 a := a and ENABLE_IRQ4;
 port[IMR]  := a;
end;


procedure remove_port;
{disables DAV, OUT2 and IRQ4 so that COM1: will no longer be serviced}
var
   a : byte;
begin
     a         := port[IMR];
     port[IMR] := a or DISABLE_IRQ4;
     port[IER] := DISABLE_DAV;
     a         := port[MCR];
     port[MCR] := a and DISABLE_OUT2;
end;


procedure break;
{send a break}
var a,b : byte;
begin
 a := port[LCR];
 b := (a and $7F) or $40;
 port[LCR] := b;
 delay(400);
 port[LCR] := a;
end;

procedure setup;
{initialize most stuff - you may want to replace this routine completely}
begin
 dbits        := 8;
 parity       := none;
 stop_bits    := 1;
 speed        := DEFAULT_BAUD;
 init_port;
 term_ready(true);
end;